home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / FORMGRPS.TPX < prev    next >
Text File  |  1994-03-02  |  56KB  |  1,062 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                              FormGrps.TPX              │Version: 3007.105│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│InitQue               GROUP                                               │
  7. #!│InitFields            GROUP                                               │
  8. #!│SecondaryLookups      GROUP                                               │
  9. #!│InsertMessage         GROUP                                               │
  10. #!│ChangeMessage         GROUP                                               │
  11. #!│DeleteMessage         GROUP                                               │
  12. #!│AutoIncCode           GROUP                                               │
  13. #!│RestoreAuto           GROUP                                               │
  14. #!│SetupConcurrency      GROUP                                               │
  15. #!│ConflictUpdate        GROUP                                               │
  16. #!│DupKeyCode            GROUP                                               │
  17. #!│ClearValues           GROUP                                               │
  18. #!│InitFormSymbols       GROUP                                               │
  19. #!│UpdateRelationSearch  GROUP                                               │
  20. #!│DeleteRelationSearch  GROUP                                               │
  21. #!│RelationalAccessFlds  GROUP                                               │
  22. #!│GenFormulas           GROUP                                               │
  23. #!│SecondaryChanged      GROUP                                               │
  24. #!│FieldDups             GROUP                                               │
  25. #!│SaveScrFlds           GROUP                                               │
  26. #!│DupFldCall            GROUP                                               │
  27. #!│DupField              GROUP                                               │
  28. #!│InitButtonExist       GROUP                                               │
  29. #!│AltKeys               GROUP                                               │
  30. #!│ProcCounter           GROUP                                               │
  31. #!│SavePrimedFields      GROUP                                               │
  32. #!│InitAutoInc           GROUP                                               │
  33. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  34. #!│Version   Comments                                                        │
  35. #!│────────  ────────────────────────────────────────────────────────────────│
  36. #!│3007.000  Release of CDD3 version 3007 templates                          │
  37. #!│3007.103  Repaired SecondaryLookups GROUP                                 │
  38. #!│          Repaired UpdateRelationSearch GROUP                             │
  39. #!│          Repaired DeleteRelationSearch GROUP                             │
  40. #!│3007.105  Repaired UpdateRelationSearch GROUP                             │
  41. #!│          Repaired DeleteRelationSearch GROUP                             │
  42. #!│          Repaired AutoIncCode GROUP                                      │
  43. #!│          Added InitAutoInc GROUP                                         │
  44. #!│          Repaired DupKeyCode GROUP                                       │
  45. #!└──────────────────────────────────────────────────────────────────────────┘
  46. #!
  47. #GROUP(%InitQue)
  48. #IF(%SharedFiles)
  49.  
  50. !─────────────────────────────────────────────────────────────────────────────
  51. InitializeQueue ROUTINE                          #<!save initial record values
  52.   FREE(RecordQueue)
  53.   Sav:SaveRecord = %FilePre:Record               #<!Save the current record
  54.   #IF(%MemoChk)
  55.     #FOR(%FileMemo)
  56.       #FIX(%Field,%FileMemo)
  57.   SAV:%FieldID   = %Field                        #<!Save the memo
  58.     #ENDFOR
  59.   #ENDIF
  60.   ADD(RecordQueue,1)                             #<!add record to Queue
  61.   ADD(RecordQueue,2)                             #<!add record again
  62.   IF ERRORCODE()                                 #<!check Queue add error
  63.     CASE ERRORCODE()
  64.       OF NoMemErr                                #<!Is there enough memory?
  65.       #INSERT(%NotEnoughMemMsg)
  66.     ELSE                                         #<!On any other error
  67.       #INSERT(%GeneralErrorMsg)
  68.     END                                          #<!End CASE Errorcode
  69.     DISABLE(1,FIELDS())                          #<!Disable the screen fields
  70.     #IF(%TableForm = %Null)
  71.     ENABLE(?Cancel)                            #<!Enable the Cancel button
  72.     SELECT(?Cancel)                            #<!Place the cursor on Cancel
  73.     #ELSIF(%TableForm)
  74.       #IF(%CancelExists = %Null)
  75.     ENABLE(%FirstField)                        #<!Enable the First Field
  76.     SELECT(%FirstField)                        #<!Place cursor on Cancel
  77.     PRESS(EscKey)
  78.       #ELSE
  79.     ENABLE(?Cancel)                            #<!Enable the Cancel button
  80.     SELECT(?Cancel)                            #<!Place the cursor on Cancel
  81.       #ENDIF
  82.     #ENDIF
  83.     DISPLAY                                    #<!Update screen display
  84.   END                                            #<!End IF Errorcode
  85.   EXIT
  86. #ENDIF
  87. #!***************************************************************************
  88. #GROUP(%InitFields)
  89. #IF(%InitRoutine = 'Y')
  90.  
  91. !─────────────────────────────────────────────────────────────────────────────
  92. InitializeFields ROUTINE
  93. #FOR(%Field)
  94. #IF(%FieldInitial <> %NULL)
  95.    %Field = %FieldInitial
  96. #ENDIF
  97. #ENDFOR
  98. #ENDIF
  99. #!***************************************************************************
  100. #GROUP(%SecondaryLookups)
  101. #!
  102. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  103. #!│                            SecondaryLookups            │Version: 3007.103│
  104. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  105. #!│Purpose:      Generate SecondaryLookups ROUTINE                           │
  106. #!│Called From:  Form, MultiPage, PageOf                                     │
  107. #!│Assumptions:  None                                                        │
  108. #!│Inserts:      GetSecondaryRecords                                         │
  109. #!│Symbols Set:  None                                                        │
  110. #!│Notes:        None                                                        │
  111. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  112. #!│Version   Comments                                                        │
  113. #!│────────  ────────────────────────────────────────────────────────────────│
  114. #!│3007.000  Release of CDD3 version 3007 templates                          │
  115. #!│3007.103  Removed the DISPLAY statement from the GROUP                    │
  116. #!└──────────────────────────────────────────────────────────────────────────┘
  117. #!
  118. !─────────────────────────────────────────────────────────────────────────────
  119. SecondaryLookups ROUTINE
  120.   #INSERT(%GetSecondaryRecords)                  #<!Lookup into Secondary files
  121. #!***************************************************************************
  122. #GROUP(%InsertMessage)
  123. #IF(%InsertMsg <> %NULL)
  124. LOC:Message = CENTER('%InsertMsg',SIZE(LOC:Message)) #<!Assign ADD message
  125. #ELSE
  126. LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message))#<!Assign ADD message
  127. #ENDIF
  128. #!***************************************************************************
  129. #GROUP(%ChangeMessage)
  130. #IF(%ChangeMsg <> %NULL)
  131. LOC:Message = CENTER('%ChangeMsg',SIZE(LOC:Message)) #<!Assign CHANGE message
  132. #ELSE
  133. LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message))#<!Assign CHANGE message
  134. #ENDIF
  135. #!***************************************************************************
  136. #GROUP(%DeleteMessage)
  137. #IF(%DeleteMsg <> %NULL)
  138. LOC:Message = CENTER('%DeleteMsg',SIZE(LOC:Message)) #<!Assign DELETE message
  139. #ELSE
  140. LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message))#<!Assign DELETE message
  141. #ENDIF
  142. #!***************************************************************************
  143. #GROUP(%AutoIncCode)
  144. #!
  145. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  146. #!│                               AutoIncCode              │Version: 3007.105│
  147. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  148. #!│Purpose:      Generate code to Automatically increment field values       │
  149. #!│Called From:  Form and MultiPage Porcedure templates                      │
  150. #!│Assumptions:  None                                                        │
  151. #!│Inserts:      %GenerateFormula                                            │
  152. #!│Symbols Set:  None                                                        │
  153. #!│Notes:        None                                                        │
  154. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  155. #!│Version   Comments                                                        │
  156. #!│────────  ────────────────────────────────────────────────────────────────│
  157. #!│3007.000  Release of CDD3 version 3007 templates                          │
  158. #!│3007.105  Repaired Descending Key code (clearing AutoIncrement field low) │
  159. #!└──────────────────────────────────────────────────────────────────────────┘
  160. #!
  161. #IF(%AutoInc)                                    #! If AutoInc Key exists
  162.  
  163. !─────────────────────────────────────────────────────────────────────────────
  164. AutoNumber Routine                               #<! Generate AutoInc Values
  165.   DO SaveAutoNumber                              #<! Save AutoNum Prime Value
  166.   DO NextAutoNumber                              #<! Generate Next Autonumber
  167.  
  168. !─────────────────────────────────────────────────────────────────────────────
  169. SaveAutoNumber ROUTINE                           #! Save AutoNum Prime Values
  170.   #FOR(%Formula)                                 #! FOR each Formula
  171.     #IF(UPPER(%FormulaClass) = 'PRIMEKEY')       #! IF it's a Prime Key formula
  172.   #INSERT(%GenerateFormula)                      #! Generate Formula Code
  173.     #ENDIF                                       #! END (IF it's a Prime...)
  174.   #ENDFOR                                        #! END (FOR each Formula)
  175.   #FIX(%File,%Primary)                           #! FIX to process Primary
  176.   #FOR(%Key)                                     #! FOR each key
  177.     #IF(%KeyAuto)                                #! IF an AutoInc key
  178.       #FOR(%KeyField)                            #! FOR each field in key
  179.         #IF(%KeyField=%KeyAuto)                  #! IF the AutoInc field
  180.           #BREAK                                 #! Stop processing key
  181.         #ENDIF                                   #! END (IF the AutoInc field)
  182.   Auto:%KeyField = %KeyField                     #<! Save current key value
  183.       #ENDFOR                                    #! END (FOR each field...)
  184.   Auto:%KeyAuto = 0                              #<! Clear AutoInc Value
  185.       #IF(%AutoIncDups)                          #! If other Dup keys exist
  186.   Auto:Hold:%KeyAuto = 0                         #<! Other Dup Key checking
  187.       #ENDIF                                     #! END (If other Dup Keys)
  188.     #ENDIF                                       #! END (IF an AutoInc key)
  189.   #ENDFOR                                        #! END (FOR each key)
  190.  
  191. !─────────────────────────────────────────────────────────────────────────────
  192. NextAutoNumber ROUTINE                           #<! Get next AutoNum Value
  193.   LOOP                                           #<! Loop for autonumbering
  194.   #FOR(%Key)                                     #! FOR each key
  195.     #IF(%KeyAuto)                                #! IF an AutoInc key
  196.     LOOP                                         #<! Loop for %Key AutoInc
  197.       #FOR(%KeyField)                            #! FOR each field in key
  198.         #IF(%KeyField=%KeyAuto)                  #! IF the AutoInc field
  199.           #SET(%ClearWritten,%Null)              #! Clear the flag
  200.           #FIX(%Field,%KeyField)                 #! Check Field Properties
  201.           #IF(UPPER(%FieldType) = 'PICTURE')     #! IF AutoInc Picture data type
  202.             #IF(INSTRING('@N',UPPER(%FieldRecordPicture),1,1)) #! If its an @n picture
  203.               #SET(%ClearWritten,'TRUE')         #! Set the Flag
  204.               #IF(%KeyFieldSequence = 'ASCENDING') #! IF Ascending Key Field
  205.       %KeyField = ALL('9')                       #<! Fill strings with 9's
  206.               #ELSE                              #! ELSE (IF NOT Ascending...)
  207.       %KeyField = ALL('0')                       #<! Fill strings with 0's
  208.               #ENDIF                             #! END (IF Ascending...)
  209.             #ENDIF                               #! END (IF its an @n...)
  210.           #ENDIF                                 #! END (AutoInc Picture...)
  211.           #IF(NOT %ClearWritten)                 #! IF Flag not set
  212.       CLEAR(%KeyField,1)                         #<! Clear to high value
  213.           #ENDIF                                 #! END (IF Flag not set)
  214.         #ELSE                                    #! ELSE (IF NOT the AutoInc...)
  215.       %KeyField = Auto:%KeyField                 #<! Set to saved values
  216.         #ENDIF                                   #! END (IF the AutoInc Field)
  217.       #ENDFOR                                    #! END (For each field...)
  218.       #FIX(%KeyField,%KeyAuto)                   #! Set up to Gen Code
  219.       SET(%Key,%Key)                             #<! %KeyFieldSequence
  220.       #IF(%KeyFieldSequence='ASCENDING')         #! IF Ascending Key
  221.       PREVIOUS(%Primary)                         #<! Read last record (Ascending)
  222.       #ELSE                                      #! ELSE (NOT Ascending Key)
  223.       NEXT(%Primary)                             #<! Read first record (Descending)
  224.       #ENDIF                                     #! END (IF Ascending Key)
  225.       IF ERRORCODE() = BadRecErr                 #<! IF No Records
  226.         Auto:%KeyAuto = 1                        #<! then start numbering at 1
  227.       ELSIF ERRORCODE()                          #<! On any other error
  228.         #INSERT(%KeyedRecordReadMsg)             #! Alert the User
  229.         DO ProcedureReturn                       #<! and leave the proc
  230.       ELSE                                       #<! ELSE (No Errorcode)
  231.       #SET(%IfWritten,%Null)                     #! Clear the Flag
  232.       #SET(%LastKeyField,%Null)                  #! Clear the Flag
  233.       #FOR(%KeyField)                            #! FOR each field in key
  234.         #IF(%KeyField=%KeyAuto)                  #! IF the AutoInc field
  235.           #BREAK                                 #! Stop processing key
  236.         #ENDIF                                   #! END (IF the AutoInc field)
  237.         #SET(%LastKeyField,%KeyField)            #! Set the Flag
  238.       #ENDFOR                                    #! END (FOR each field...)
  239.       #IF(%LastKeyField)                         #! IF multiple field key
  240.         #FOR(%KeyField)                          #! FOR each field in key
  241.           #IF(%KeyField=%LastKeyField)           #! IF this element is last
  242.             #IF(%IfWritten)                      #! IF flag is set
  243.         AND Auto:%KeyField = %KeyField           #<! Check for valid value
  244.             #ELSE                                #! ELSE (IF flag is not set)
  245.         IF Auto:%KeyField = %KeyField            #<! IF valid value
  246.             #ENDIF                               #! END (IF flag is set)
  247.             #BREAK                               #! Stop Processing Key
  248.           #ELSE                                  #! ELSE (IF not last...)
  249.             #IF(%IfWritten)                      #! IF flag is set
  250.         AND Auto:%KeyField = %KeyField|          #<! Check for valid value
  251.             #ELSE                                #! ELSE (IF flag is not set)
  252.         IF Auto:%KeyField = %KeyField|           #<! IF valid value
  253.               #SET(%IfWritten,'TRUE')            #! SET the Flag
  254.             #ENDIF                               #! END (IF flag is set)
  255.           #ENDIF                                 #! END (IF this element...)
  256.         #ENDFOR                                  #! END (FOR each field...)
  257.           Auto:%KeyAuto = %KeyAuto + 1           #<! Get next value
  258.         ELSE                                     #<! IF not valid value
  259.           Auto:%KeyAuto = 1                      #<! Get first value
  260.         END                                      #<! END (IF valid value)
  261.       #ELSE                                      #! ELSE (IF NOT multiple...)
  262.         Auto:%KeyAuto = %KeyAuto + 1             #<! Get next value
  263.       #ENDIF                                     #! END (FOR each field...)
  264.       END                                        #<! END (IF No Records)
  265.       #FOR(%KeyField)                            #! FOR each field in key
  266.       %KeyField = Auto:%KeyField                 #<! Restore key value
  267.         #IF(%KeyField=%KeyAuto)                  #! IF the AutoInc field
  268.           #BREAK                                 #! Stop processing key
  269.         #ENDIF                                   #! END (IF the AutoInc field)
  270.       #ENDFOR                                    #! END (FOR each field...)
  271.       IF DUPLICATE(%Key)                         #<! IF value already exists
  272.         CYCLE                                    #<! Try again
  273.       END                                        #<! END (IF Value already...)
  274.       BREAK                                      #<! Quit processing this key
  275.     END                                          #<! END (Loop for %Key ...)
  276.     #ENDIF                                       #! End IF %KeyAuto
  277.   #ENDFOR                                        #! End FOR KEY
  278.     #INSERT(%ClearValues)                        #! Clear the Record
  279.   #FOR(%Key)                                     #! FOR each Key
  280.     #IF(%KeyAuto)                                #! IF an AutoInc Key
  281.       #FOR(%KeyField)                            #! FOR each field of key
  282.     %KeyField = Auto:%KeyField                   #<! Restore values
  283.         #IF(%KeyField=%KeyAuto)                  #! IF the AutoInc field
  284.           #BREAK                                 #! Stop processing key
  285.         #ENDIF                                   #! END (IF the AutoInc field)
  286.       #ENDFOR                                    #! END (FOR each field...)
  287.     #ENDIF                                       #! END (IF an AutoInc Key)
  288.   #ENDFOR                                        #! END (FOR each Key)
  289.     ADD(%Primary)                                #<! Add the record now
  290.     IF ERRORCODE()                               #<! Was there an error?
  291.       CASE ERRORCODE()                           #<! Process errors
  292.       OF DupKeyErr                               #<! Is it a duplicate key?
  293.   #IF(%AutoIncDups)                              #! If other Dup keys exist
  294.     #SET(%KeyCounter,%Null)                      #! Clear the counter
  295.     #SET(%IfWritten,%Null)                       #! Clear the flag
  296.     #FOR(%Key)                                   #! FOR each Key
  297.       #IF(%KeyAuto)                              #! IF an AutoInc Key
  298.         #SET(%KeyCounter,(%KeyCounter+1))        #! Increment the Counter
  299.       #ENDIF                                     #! END (IF an AutoInc Key)
  300.     #ENDFOR                                      #! END (FOR each Key)
  301.     #FOR(%Key)                                   #! FOR each Key
  302.       #IF(%KeyAuto)                              #! IF an AutoInc Key
  303.         #IF(%KeyCounter='1')                     #! IF the last AutoInc Key
  304.           #IF(%IfWritten)                        #! If the flag is set
  305.         AND Auto:Hold:%KeyAuto = %KeyAuto        #<! Same value as last time
  306.           #ELSE                                  #! ELSE (If the flag is not...)
  307.         IF Auto:Hold:%KeyAuto = %KeyAuto         #<! Same value as last time
  308.           #ENDIF                                 #! END (If the flag is set)
  309.         #ELSE                                    #! END (IF NOT the last AutoInc Key)
  310.           #IF(%IfWritten)                        #! If the flag is set
  311.         AND Auto:Hold:%KeyAuto = %KeyAuto|       #<! Same value as last time
  312.           #ELSE                                  #! ELSE (If the flag is not...)
  313.         IF Auto:Hold:%KeyAuto = %KeyAuto|        #<! Same value as last time
  314.             #SET(%IfWritten,'TRUE')              #! Set the flag
  315.           #ENDIF                                 #! END (If the flag is set)
  316.         #ENDIF                                   #! END (IF the last AutoInc Key)
  317.         #SET(%KeyCounter,(%KeyCounter-1))        #! Increment the Counter
  318.       #ENDIF                                     #! END (IF an AutoInc Key)
  319.     #ENDFOR                                      #! END (FOR each Key)
  320.           #INSERT(%AutoIncDuplicateMsg)          #! Alert the User
  321.         ELSE                                     #<! ELSE (If not same as last)
  322.     #FOR(%Key)                                   #! FOR each Key
  323.       #IF(%KeyAuto)                              #! IF an AutoInc Key
  324.           Auto:Hold:%KeyAuto = %KeyAuto          #! Save Value for next time
  325.       #ENDIF                                     #! END (IF an AutoInc Key)
  326.     #ENDFOR                                      #! END (FOR each Key)
  327.           CYCLE                                  #<! then try again
  328.         END                                      #<! END (IF the same as...)
  329.   #ELSE                                          #! ELSE (If other Dup Keys...)
  330.         CYCLE                                    #<! then try again
  331.   #ENDIF                                         #! END (If other Dup Keys exist)
  332.       ELSE                                       #<! ELSE (unexplained error)
  333.         IF DiskError('Record could not be ADDed')#<! Check any other error
  334.           DO ProcedureReturn                     #<! Leave the procedure
  335.         END                                      #<! End IF Diskerror
  336.       END                                        #<! End CASE errorcode
  337.     ELSE                                         #<! Else no error
  338.       BREAK                                      #<! so BREAK Loop
  339.     END                                          #<! End IF errorcode
  340.   END                                            #<! End LOOP for Autonumbering
  341.   AutoIncAdd = True                              #<! Switch AutoIncAdd ON
  342.   AutoAddPtr = POSITION(%Primary)                #<! Save the record position
  343.   RESET(%Primary,AutoAddPtr)                     #<! Position to record we added
  344.   #IF(%SharedFiles)                              #! IF generating MultiUser code
  345.   HOLD(%Primary,4)                               #<! Hold the record
  346.   NEXT(%Primary)                                 #<! and read it in to buffer
  347.   IF DiskError('Could not READ Record')          #<! Check for I/O error
  348.     DO ProcedureReturn                           #<! Leave the procedure
  349.   END                                            #<! End IF Diskerror
  350.   #ENDIF
  351.   Action = ChangeRecord                          #<! Action is now change
  352.   EXIT                                           #<! Exit the routine
  353. #ENDIF
  354. #!***************************************************************************
  355. #GROUP(%RestoreAuto)
  356.     #FOR(%Key)
  357.     #IF(%KeyAuto <> %NULL)
  358. %KeyAuto = %KeyAuto:AutoInc#                     #<!Restore incremented value
  359.     #ENDIF
  360.     #ENDFOR
  361. #!***************************************************************************
  362. #GROUP(%SetupConcurrency)
  363. DO InitializeQueue                               #<!Save record to QUEUE
  364. SavePointer = POSITION(%Primary)                 #<!Save the record position
  365. #!***************************************************************************
  366. #GROUP(%ConflictUpdate)
  367. PUT(RecordQueue)                                 #<!Update the memory Queue
  368. #INSERT(%RecordChangedMsg)
  369. SELECT(1)                                        #<!Place cursor on 1st field
  370. DISPLAY                                          #<!Update the screen
  371. AbortTransaction = True                          #<!Turn AbortWrite# ON
  372. EXIT                                             #<!Exit the Routine
  373. #!***************************************************************************
  374. #GROUP(%DupKeyCode)
  375. #!
  376. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  377. #!│                                DupKeyCode              │Version: 3007.105│
  378. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  379. #!│Purpose:      Generate check of each key that is unique for duplicates    │
  380. #!│Called From:  Form PROCEDURE                                              │
  381. #!│              MultiPage PROCEDURE                                         │
  382. #!│Assumptions:  None                                                        │
  383. #!│Inserts:      DupKeyErrorMsg                                              │
  384. #!│Symbols Set:  None                                                        │
  385. #!│Notes:        None                                                        │
  386. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  387. #!│Version   Comments                                                        │
  388. #!│────────  ────────────────────────────────────────────────────────────────│
  389. #!│3007.000  Release of CDD3 version 3007 templates                          │
  390. #!│3007.105  Moved Error message to DupKeyErrorMsg in Warnings.TPX           │
  391. #!└──────────────────────────────────────────────────────────────────────────┘
  392. #!
  393. #FIX(%File,%Primary)
  394. IF ERRORCODE() = DupKeyErr                       #<! Duplicate key detected
  395.   #FOR(%Key)
  396.   #IF(UPPER(%KeyDuplicate) <> 'Y')
  397.   IF DUPLICATE(%Key)                             #<!check unique keys
  398.     #IF(%SharedFiles = 'TRUE')
  399.     RELEASE(%File)                               #<!Release the HOLD
  400.     #ENDIF
  401.     #INSERT(%DupKeyErrorMsg)
  402.   END
  403.   #ENDIF
  404.   #ENDFOR
  405.   SELECT(1)                                      #<!select first field
  406.   DISPLAY                                        #<!re-display the screen
  407.   CYCLE                                          #<!back to main loop
  408. END                                              #<!End IF Duplicate errorcode
  409. #!***************************************************************************
  410. #GROUP(%ClearValues)
  411. CLEAR(%FilePre:Record)                           #<!CLEAR Record buffer
  412. #FOR(%FileMemo)
  413. CLEAR(%FileMemo)                                 #<!CLEAR Memo buffer
  414. #ENDFOR
  415. #!***************************************************************************
  416. #GROUP(%InitFormSymbols)
  417. #!                     INITIALIZE FORM TEMPLATE SYMBOLS
  418. #!────────────────────────────────────────────────────────────────────────────
  419. #!User Defined Symbols              Purpose/Meaning
  420. #!────────────────────────────────────────────────────────────────────────────
  421.   #SET(%HotKeysExist,%Null)       #!Do Hot Keys Exist
  422.   #SET(%AutoInc,%Null)            #!Does %Primary use an Auto-Increment key
  423.   #SET(%DupKeyCheck,%Null)        #!Does a ,DUP key exist for %Primary
  424.   #SET(%LoopFormulasExist,%Null)  #!Do unclassed formulas exist?
  425.   #SET(%PrimeKeysExist,%Null)     #!Are there any PrimeKey formulas
  426.   #SET(%MemoChk,%Null)            #!Are any memos present in Primary
  427.   #SET(%InitRoutine,%Null)        #!Do any fields have initial values?
  428.   #SET(%FileControlMode,%Null)    #!Controls writing of file opening/closing
  429.   #SET(%ControlLookups,'Y')       #!Searches Lookups for opening/closing
  430.   #SET(%ControlRelatedFiles,'Y')  #!Searches relations for opening/closing
  431.   #SET(%RelatedFileListing,%Null) #!List Containing Related Files
  432.   #SET(%LevelOne,%Null)           #!
  433.   #SET(%LevelOneLinks,%Null)      #!
  434.   #SET(%LinkPool,%Null)           #!
  435.   #SET(%RelatedFiles,%Null)       #!
  436.   #SET(%RestrictDelete,%Null)     #!
  437.   #SET(%RestrictUpdate,%Null)     #!
  438.   #SET(%CascadeDelete,%Null)      #!
  439.   #SET(%CascadeUpdate,%Null)      #!
  440.   #SET(%ClearOnDelete,%Null)      #!
  441.   #SET(%ClearOnUpdate,%Null)      #!
  442.   #SET(%SecondaryExist,%Null)     #!
  443.   #SET(%PrimaryUpdateConst,%Null)
  444.   #SET(%PrimaryDeleteConst,%Null)
  445.   #SET(%RelationString,%Null)
  446.   #SET(%ChildPre,%Null)
  447.   #SET(%ParentPre,%Null)
  448.   #SET(%AllRelations,%Null)
  449.   #SET(%RelatedChildList,%Null)
  450.   #SET(%RelatedParentList,%Null)
  451.   #SET(%UpdateRelations,%Null)
  452.   #SET(%UpdateChildList,%Null)
  453.   #SET(%UpdateParentList,%Null)
  454.   #SET(%DeleteRelations,%Null)
  455.   #SET(%DeleteChildList,%Null)
  456.   #SET(%DeleteParentList,%Null)
  457.   #SET(%ControlRelatedFiles,'TRUE')
  458.   #SET(%NonStopSelect,'TRUE')
  459.  
  460. #FIX(%File,%Primary)                             #!Prime File symbols
  461. #SET(%PrimaryDriver,%FileType)                   #!Retrieve the file driver
  462. #FOR(%HotKey)                                    #!For Each Hot Key
  463.  #IF(%HotKeyProc)                                #!If there is a procedure
  464.   #SET(%HotKeysExist,'Y')                        #!Set the flag
  465.   #BREAK                                         #!and stop looking
  466.  #ENDIF                                          #!END (if %HotKeyProc)
  467. #ENDFOR                                          #!END (for %HotKey)
  468. #FOR(%Key)                                       #!For each key of %Primary
  469.   #IF(%KeyAuto)                                  #!If asks for Auto Increment
  470.     #SET(%AutoInc,'Y')                           #!Set the flag
  471.   #ENDIF                                         #!END (if %KeyAuto)
  472.   #IF(%KeyDuplicate <> 'Y')                      #!If dup checking needed
  473.     #SET(%DupKeyCheck,'Y')                       #!Set the Flag
  474.   #ENDIF                                         #!END (if %KeyDuplicate)
  475. #ENDFOR                                          #!END (for %Key)
  476. #FOR(%Formula)                                   #!For each formula
  477.   #IF(UPPER(%FormulaClass) = '')                 #!If there's no class
  478.     #SET(%LoopFormulasExist,'Y')                 #!Flag for loop processing
  479.   #ENDIF                                         #!END (if formulaclass = '')
  480.   #IF(UPPER(%FormulaClass) = 'PRIMEKEY')         #!Formula primes key values
  481.     #SET(%PrimeKeysExist,'Y')                    #!Set the Flag
  482.   #ENDIF                                         #!END (if formulaclass = 'P...')
  483. #ENDFOR                                          #!END (for %Formula)
  484. #FOR(%FileMemo)                                  #!For each memo field
  485.   #SET(%MemoChk,'Y')                             #!Set a flag that one exists
  486.   #BREAK                                         #!and stop looking
  487. #ENDFOR                                          #!END (for %FileMemo)
  488. #FOR(%Field)                                     #!For each field of Primary
  489.   #IF(%FieldInitial <> %NULL)                    #!If Field has initial value
  490.     #SET(%InitRoutine,'Y')                       #!Flag for initializing code
  491.     #BREAK                                       #!and quit looking
  492.   #ENDIF                                         #!END (if %FieldInitial)
  493. #ENDFOR                                          #!END (for Field)
  494. #SET(%ProcessingFile,%Primary)                   #!Set for Relations Search
  495. #INSERT(%UpdateRelationSearch)                   #!Retrieves Relations
  496. #SET(%ProcessingFile,%Primary)                   #!Set for Relations Search
  497. #INSERT(%DeleteRelationSearch)                   #!Retrieves Relations
  498. #FOR(%Secondary)                                 #!For each secondary file
  499.   #IF(%SecondaryType = 'MANY:1')                 #!If relation = Many:1
  500.     #SET(%SecondaryExist,'Y')                    #!Set SecondaryExist flag
  501.   #ENDIF                                         #!END (if SecondaryType = Many:1)
  502. #ENDFOR                                          #!END (for Secondary)
  503. #!***************************************************************************
  504. #GROUP(%UpdateRelationSearch)
  505. #!
  506. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  507. #!│                          UpdateRelationSearch          │Version: 3007.105│
  508. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  509. #!│Purpose:      Generate Symbols for RI Update code                         │
  510. #!│Called From:  InitFormSymbols GROUP                                       │
  511. #!│Assumptions:  That %ProcessingFile contains the label of a file           │
  512. #!│Inserts:      UpdateRelationSearch (Recursive)                            │
  513. #!│Symbols Set:  %AllRelations                                               │
  514. #!│                Contains listing of all CONSTRAINED 1:Many Relations      │
  515. #!│              %RelatedParentListing                                       │
  516. #!│                Contains listing of all files in procedure acting as      │
  517. #!│                the Parent in a 1:Many Relation                           │
  518. #!│              %RelatedChildListing                                        │
  519. #!│                Contains listing of all files in procedure acting as      │
  520. #!│                the Child in a 1:Many Relation                            │
  521. #!│              %UpdateParentListing                                        │
  522. #!│                Contains listing of all files in procedure acting as      │
  523. #!│                the Parent in a 1:Many Relation with update constraints   │
  524. #!│              %UpdateChildListing                                         │
  525. #!│                Contains listing of all files in procedure acting as      │
  526. #!│                the Child in a 1:Many Relation with update constraints    │
  527. #!│Notes:        The listings maintained in the above symbols use file       │
  528. #!│              PREFIXes, rather than labels.  The use of PREFIXes allows   │
  529. #!│              us to handle many more files, since we are storing relations│
  530. #!│              in, effectively, string variables.  by using PREFIXes, we   │
  531. #!│              get many more relations recorded and handled.               │
  532. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  533. #!│Version   Comments                                                        │
  534. #!│────────  ────────────────────────────────────────────────────────────────│
  535. #!│3007.000  Release of CDD3 version 3007 templates                          │
  536. #!│3007.103  Repaired recursive call.  The recursive call was taking place   │
  537. #!│          too deep in the #IF stack (three #IFs per iteration).  The      │
  538. #!│          recursive call was moved to take place only one level of #IF    │
  539. #!│          deep, which (theoretically) should move the limiting factor     │
  540. #!│          on levels of recursion to the #FOR stack.                       │
  541. #!│3007.105  Added percent symbols to the line that #SETs %RelationString.   │
  542. #!│          This bug caused no immediate generator errors, as the 3007      │
  543. #!│          Generator strips out the % symbols in evaluated expressions, but│
  544. #!│          is fixed for consistancy.                                       │
  545. #!└──────────────────────────────────────────────────────────────────────────┘
  546. #!
  547. #FIX(%File,%ProcessingFile)
  548. #SET(%ProcessingFile,%Null)
  549. #FOR(%Relation)
  550.   #IF(%RelationType = '1:MANY')
  551.     #IF(%RelationConstraintUpdate)
  552.       #SET(%NoLinkFound,%Null)
  553.       #FOR(%RelationKeyField)
  554.         #IF(UPPER(%RelationKeyFieldLink)='TODO')
  555.           #ERROR(' DICTIONARY ERROR!')
  556.           #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  557.           #ERROR(%ErrorMessage)
  558.           #ERROR('  contains undefined (TODO) links.')
  559.           #ERROR('  Code generated will NOT compile')
  560.           #ERROR('')
  561.         #ELSIF(%RelationKeyFieldLink)
  562.           #IF(%NoLinkFound)
  563.             #ERROR(' DICTIONARY ERROR!')
  564.             #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  565.             #ERROR(%ErrorMessage)
  566.             #ERROR('  is an unenforcable constrained UPDATE relation.')
  567.             #ERROR('  A non-linked key element on the MANY side of a')
  568.             #ERROR('  relation may not be followed by linked key elements.')
  569.             #ERROR('  Code generated will NOT compile')
  570.             #ERROR('')
  571.           #ENDIF
  572.         #ELSE
  573.           #SET(%NoLinkFound,'TRUE')
  574.         #ENDIF
  575.       #ENDFOR
  576.     #ENDIF
  577.     #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  578.     #SET(%ParentPre,('['&%FilePre&']'))
  579.     #SET(%ChildPre,('['&%RelationPre&']'))
  580.     #IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
  581.       #SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
  582.     #ENDIF
  583.     #IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
  584.       #SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
  585.     #ENDIF
  586.     #IF(%RelationConstraintUpdate)
  587.       #SET(%UpdateRelations,(%UpdateRelations&%RelationString))
  588.       #SET(%AllRelations,(%AllRelations&%RelationString))
  589.       #IF((INSTRING(%ParentPre,%UpdateParentList,1,1))=0)
  590.         #SET(%UpdateParentList,(%UpdateParentList&%ParentPre))
  591.       #ENDIF
  592.       #IF((INSTRING(%ChildPre,%UpdateChildList,1,1))=0)
  593.         #SET(%UpdateChildList,(%UpdateChildList&%ChildPre))
  594.       #ENDIF
  595.       #SET(%ProcessingFile,%Null)
  596.       #IF(%RelationConstraintUpdate<>'RESTRICT')
  597.         #SET(%ProcessingFile,%Relation)
  598.       #ENDIF
  599.     #ENDIF
  600.   #ENDIF
  601.   #IF(%ProcessingFile)
  602. #INSERT(%UpdateRelationSearch)
  603.   #ENDIF
  604. #ENDFOR
  605. #!***************************************************************************
  606. #GROUP(%DeleteRelationSearch)
  607. #!
  608. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  609. #!│                          DeleteRelationSearch          │Version: 3007.105│
  610. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  611. #!│Purpose:      Generate Symbols for RI Delete code                         │
  612. #!│Called From:  InitFormSymbols GROUP                                       │
  613. #!│Assumptions:  That %ProcessingFile contains the label of a file           │
  614. #!│Inserts:      DeleteRelationSearch (Recursive)                            │
  615. #!│Symbols Set:  %AllRelations                                               │
  616. #!│                Contains listing of all CONSTRAINED 1:Many Relations      │
  617. #!│              %RelatedParentListing                                       │
  618. #!│                Contains listing of all files in procedure acting as      │
  619. #!│                the Parent in a 1:Many Relation                           │
  620. #!│              %RelatedChildListing                                        │
  621. #!│                Contains listing of all files in procedure acting as      │
  622. #!│                the Child in a 1:Many Relation                            │
  623. #!│              %DeleteParentListing                                        │
  624. #!│                Contains listing of all files in procedure acting as      │
  625. #!│                the Parent in a 1:Many Relation with update constraints   │
  626. #!│              %DeleteChildListing                                         │
  627. #!│                Contains listing of all files in procedure acting as      │
  628. #!│                the Child in a 1:Many Relation with update constraints    │
  629. #!│Notes:        The listings maintained in the above symbols use file       │
  630. #!│              PREFIXes, rather than labels.  The use of PREFIXes allows   │
  631. #!│              us to handle many more files, since we are storing relations│
  632. #!│              in, effectively, string variables.  by using PREFIXes, we   │
  633. #!│              get many more relations recorded and handled.               │
  634. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  635. #!│Version   Comments                                                        │
  636. #!│────────  ────────────────────────────────────────────────────────────────│
  637. #!│3007.000  Release of CDD3 version 3007 templates                          │
  638. #!│3007.103  Repaired recursive call.  The recursive call was taking place   │
  639. #!│          too deep in the #IF stack (three #IFs per iteration).  The      │
  640. #!│          recursive call was moved to take place only one level of #IF    │
  641. #!│          deep, which (theoretically) should move the limiting factor     │
  642. #!│          on levels of recursion to the #FOR stack.                       │
  643. #!│3007.105  Added percent symbols to the line that #SETs %RelationString.   │
  644. #!│          This bug caused no immediate generator errors, as the 3007      │
  645. #!│          Generator strips out the % symbols in evaluated expressions, but│
  646. #!│          is fixed for consistancy.                                       │
  647. #!└──────────────────────────────────────────────────────────────────────────┘
  648. #!
  649. #FIX(%File,%ProcessingFile)
  650. #SET(%ProcessingFile,%Null)
  651. #FOR(%Relation)
  652.   #IF(%RelationType = '1:MANY')
  653.     #IF(%RelationConstraintDelete)
  654.       #SET(%NoLinkFound,%Null)
  655.       #FOR(%RelationKeyField)
  656.         #IF(UPPER(%RelationKeyFieldLink)='TODO')
  657.           #ERROR(' DICTIONARY ERROR!')
  658.           #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  659.           #ERROR(%ErrorMessage)
  660.           #ERROR('  contains undefined (TODO) links.')
  661.           #ERROR('  Code generated will NOT compile')
  662.           #ERROR('')
  663.         #ELSIF(%RelationKeyFieldLink)
  664.           #IF(%NoLinkFound)
  665.             #ERROR(' DICTIONARY ERROR!')
  666.             #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  667.             #ERROR(%ErrorMessage)
  668.             #ERROR('  is an unenforcable constrained DELETE relation.')
  669.             #ERROR('  A non-linked key element on the MANY side of a')
  670.             #ERROR('  relation may not be followed by linked key elements.')
  671.             #ERROR('  Code generated will NOT compile')
  672.             #ERROR('')
  673.           #ENDIF
  674.         #ELSE
  675.           #SET(%NoLinkFound,'TRUE')
  676.         #ENDIF
  677.       #ENDFOR
  678.     #ENDIF
  679.     #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  680.     #SET(%ParentPre,('['&%FilePre&']'))
  681.     #SET(%ChildPre,('['&%RelationPre&']'))
  682.     #IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
  683.       #SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
  684.     #ENDIF
  685.     #IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
  686.       #SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
  687.     #ENDIF
  688.     #IF(%RelationConstraintDelete)
  689.       #SET(%DeleteRelations,(%DeleteRelations&%RelationString))
  690.       #IF((INSTRING(%RelationString,%AllRelations,1,1))=0)
  691.         #SET(%AllRelations,(%AllRelations&%RelationString))
  692.       #ENDIF
  693.       #IF((INSTRING(%ParentPre,%DeleteParentList,1,1))=0)
  694.         #SET(%DeleteParentList,(%DeleteParentList&%ParentPre))
  695.       #ENDIF
  696.       #IF((INSTRING(%ChildPre,%DeleteChildList,1,1))=0)
  697.         #SET(%DeleteChildList,(%DeleteChildList&%ChildPre))
  698.       #ENDIF
  699.       #IF(%RelationConstraintDelete<>'RESTRICT')
  700.         #SET(%ProcessingFile,%Relation)
  701.       #ENDIF
  702.     #ENDIF
  703.   #ENDIF
  704.   #IF(%ProcessingFile)
  705. #INSERT(%DeleteRelationSearch)
  706.   #ENDIF
  707. #ENDFOR
  708. #!*************************************************************************
  709. #GROUP(%RelationalAccessFlds)
  710. #FOR(%File)
  711.   #SET(%ParentPre,('['&%FilePre&']'))
  712.   #IF((INSTRING(%ParentPre,%RelatedParentList,1,1)))
  713.     #FOR(%Relation)
  714.       #SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
  715.       #IF((INSTRING(%RelationString,%AllRelations,1,1)))
  716.         #FOR(%RelationKeyField)
  717.           #IF(%RelationKeyFieldLink <> %NULL)
  718.             #FIX(%Field,%RelationKeyFieldLink)
  719.             #IF(%FieldType = 'GROUP')
  720. %RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink),PRE(LNK) #<!Define a link field
  721.             #ELSE
  722. %RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink) #<!Define a link field
  723.             #ENDIF
  724.           #ENDIF
  725.         #ENDFOR
  726.       #ENDIF
  727.     #ENDFOR
  728.   #ENDIF
  729. #ENDFOR
  730. #!**************************************************************************
  731. #GROUP(%GenFormulas)
  732. #IF(%GenerateFormulasOn)
  733.  
  734. !─────────────────────────────────────────────────────────────────────────────
  735. FormulaFields ROUTINE
  736.  #FOR(%Formula)
  737.   #IF(UPPER(%FormulaClass) <> 'PRIMEKEY')
  738.   #IF(UPPER(%FormulaClass) <> 'SETUP')
  739.   #IF(UPPER(%FormulaClass) <> 'RETURN')
  740.    #IF(%CodePosition = %NULL OR %CodePosition = %FormulaClass)
  741.      #IF(%FormulaType = 'COMPUTED')
  742.   %Formula = %FormulaComputation                 #<!Computed Formula (no class)
  743.      #ELSE
  744.   IF %FormulaCondition                           #<!If Formula condition
  745.     %Formula = %FormulaTrue                      #<! is TRUE
  746.        #IF(%FormulaFalse)
  747.   ELSE                                           ! else
  748.     %Formula = %FormulaFalse                     #<! condition is FALSE
  749.        #ENDIF
  750.   END                                            #<!End formula condition
  751.        #ENDIF
  752.        #SET(%CurrentFormula,('?' & %Formula))
  753.        #FIX(%Screenfield,%CurrentFormula)
  754.        #IF(%Screenfield)
  755.   DISPLAY(?%Formula)                             #<!Update screen display
  756.        #ENDIF
  757.    #ENDIF
  758.  
  759.   #ENDIF                                         #!Not PrimeKey class
  760.   #ENDIF                                         #!Not Setup class
  761.   #ENDIF                                         #!Not Return class
  762.  
  763.  #ENDFOR
  764. #ENDIF
  765. #!**************************************************************************
  766. #GROUP(%SecondaryChanged)
  767. #SET(%KeyFieldCounter,%Null)
  768. #SET(%IfWritten,%Null)
  769. #FOR(%Secondary)                                #! for fields on the form
  770.   #IF(%SecondaryType = 'MANY:1')                #!Check for lookup files
  771.     #FIX(%File,%SecondaryTo)
  772.     #FIX(%Relation,%Secondary)
  773.     #FOR(%RelationKeyField)
  774.       #IF(RelationKeyFieldLink)
  775.         #SET(%KeyFieldCounter,(%KeyFieldCounter+1))
  776.       #ENDIF
  777.     #ENDFOR
  778.   #ENDIF
  779. #ENDFOR
  780. #FIX(%File,%Primary)
  781. #IF(%KeyFieldCounter)
  782.   #FOR(%Secondary)                              #! for fields on the form
  783.     #IF(%SecondaryType = 'MANY:1')              #!Check for lookup files
  784.       #FIX(%File,%SecondaryTo)
  785.       #FIX(%Relation,%Secondary)
  786.       #FOR(%RelationKeyField)
  787.         #IF(RelationKeyFieldLink)
  788.           #IF(%KeyFieldCounter='1')
  789.             #IF(%IfWritten)
  790. OR %RelationKeyField <> %RelationKeyFieldLink    #<!Check for changes
  791.             #ELSE
  792. IF %RelationKeyField <> %RelationKeyFieldLink    #<!Check for changes
  793.             #ENDIF
  794.             #BREAK
  795.           #ELSE
  796.             #IF(%IfWritten)
  797. OR %RelationKeyField <> %RelationKeyFieldLink  | #<!Check for changes
  798.             #ELSE
  799. IF %RelationKeyField <> %RelationKeyFieldLink   |#<!Check for changes
  800.             #SET(%IfWritten,'TRUE')
  801.             #ENDIF
  802.             #SET(%KeyFieldCounter,(%KeyFieldCounter-1))
  803.           #ENDIF
  804.         #ENDIF
  805.       #ENDFOR
  806.     #ENDIF
  807.   #ENDFOR
  808.   DO SecondaryLookups                            #<!Call lookup Routine
  809.   DISPLAY
  810. END
  811. #ENDIF
  812. #!***************************************************************************
  813. #GROUP(%FieldDups)
  814. #FOR(%ScreenField)
  815.   #IF(%ScreenFieldUse)
  816.     #SET(%Fld,%ScreenFieldUse)
  817.     #FIX(%Field,%ScreenFieldUse)
  818.     #IF(SUB(%Fld,1,1) <> '?')
  819.       #IF(%FieldID)
  820.         #IF(UPPER(%FieldFile) = UPPER(%Primary))
  821.           #IF(%FieldDimension1)
  822.             #IF(INSTRING(%Field,%DimPool,1,1) = '0')
  823.               #SET(%DimPool,(%DimPool & ',' & %Field))
  824. Dup::%Field          LIKE(%Field)
  825.             #ENDIF
  826.           #ELSE
  827.             #IF(%FieldType = 'GROUP')
  828. Dup::%ScreenFieldUse LIKE(%ScreenFieldUse),PRE(Dup)
  829.             #ELSE
  830. Dup::%ScreenFieldUse LIKE(%ScreenFieldUse)
  831.             #ENDIF
  832.           #ENDIF
  833.         #ENDIF
  834.       #ENDIF
  835.     #ENDIF
  836.   #ENDIF
  837. #ENDFOR
  838. #!***************************************************************************
  839. #GROUP(%SaveScrFlds)
  840.  
  841. !─────────────────────────────────────────────────────────────────────────────
  842. SaveScrFlds ROUTINE
  843.  #FOR(%ScreenField)
  844.  #IF(%ScreenFieldUse)
  845.   #SET(%Fld,%ScreenFieldUse)
  846.    #FIX(%Field,%ScreenFieldUse)
  847.   #IF(SUB(%Fld,1,1) <> '?')
  848.     #IF(%FieldID)
  849.       #IF(UPPER(%FieldFile) = UPPER(%Primary))
  850.   Dup::%ScreenFieldUse = %ScreenFieldUse         #<!Save screen entry
  851.       #ENDIF
  852.     #ENDIF
  853.   #ENDIF
  854.  #ENDIF
  855.  #ENDFOR
  856. #!***************************************************************************
  857. #GROUP(%DupFldCall)
  858. IF KEYCODE() = %CopyKey                          #<!User requested field copy
  859.   DO DupField                                    #<!Call duplication Routine
  860. END                                              #<!End copy key check
  861. #!***************************************************************************
  862. #GROUP(%DupField)
  863.  
  864. !─────────────────────────────────────────────────────────────────────────────
  865. DupField ROUTINE
  866.   CASE SELECTED()                                !Which field is selected?
  867.  #FOR(%ScreenField)
  868.  #IF(%ScreenFieldUse)
  869.   #SET(%Fld,%ScreenFieldUse)
  870.    #FIX(%Field,%ScreenFieldUse)
  871.   #IF(SUB(%Fld,1,1) <> '?')
  872.     #IF(%FieldID)
  873.       #IF(UPPER(%FieldFile) = UPPER(%Primary))
  874.     OF ?%ScreenFieldUse
  875.       %ScreenFieldUse = Dup::%ScreenFieldUse     #<!Move saved entry to screen
  876.       #ENDIF
  877.     #ENDIF
  878.   #ENDIF
  879.  #ENDIF
  880.  #ENDFOR
  881.   END                                            #<!End Case Selected
  882.   DISPLAY                                        #<!Update screen display
  883. #!***************************************************************************
  884. #GROUP(%InitButtonExist)
  885.   #FIX(%ScreenField,'?Previous_Page')
  886.   #IF(%ScreenField)
  887.     #SET(%PrevExist,'1')
  888.   #ELSE
  889.     #SET(%PrevExist,%NULL)
  890.   #ENDIF
  891.   #FIX(%ScreenField,'?Next_Page')
  892.   #IF(%ScreenField)
  893.     #SET(%NextExist,'1')
  894.   #ELSE
  895.     #SET(%NextExist,%NULL)
  896.   #ENDIF
  897.   #FIX(%ScreenField,'?Base_Page')
  898.   #IF(%ScreenField)
  899.     #SET(%BaseExist,'1')
  900.   #ELSE
  901.     #SET(%BaseExist,%NULL)
  902.   #ENDIF
  903.   #FIX(%ScreenField,'?Last_Page')
  904.   #IF(%ScreenField)
  905.     #SET(%LastExist,'1')
  906.   #ELSE
  907.     #SET(%LastExist,%NULL)
  908.   #ENDIF
  909.   #FIX(%ScreenField,'?Ok')
  910.   #IF(%ScreenField)
  911.     #SET(%OkayExist,'1')
  912.   #ELSE
  913.     #SET(%OkayExist,%NULL)
  914.   #ENDIF
  915. #!***************************************************************************
  916. #GROUP(%AltKeys)
  917. #IF(%Page2Proc)
  918. OF Alt2                                          !Hotkey to Page 2
  919.   PRESS(AltN)                                    !Press Next_Page Key
  920. #ENDIF
  921. #IF(%Page3Proc)
  922. OF Alt3                                          !Hotkey to Page 3
  923.   LOC:Page = 2                                   !Press Next_Page Key
  924.   PRESS(AltN)
  925. #ENDIF
  926. #IF(%Page4Proc)
  927. OF Alt4                                          !Hotkey to Page 4
  928.   LOC:Page = 3                                   !Press Next_Page Key
  929.   PRESS(AltN)
  930. #ENDIF
  931. #IF(%Page5Proc)
  932. OF Alt5                                          !Hotkey to Page 5
  933.   LOC:Page = 4                                   !Press Next_Page Key
  934.   PRESS(AltN)
  935. #ENDIF
  936. #IF(%Page6Proc)
  937. OF Alt6                                          !Hotkey to Page 6
  938.   LOC:Page = 5                                   !Press Next_Page Key
  939.   PRESS(AltN)
  940. #ENDIF
  941. #IF(%Page7Proc)
  942. OF Alt7
  943.   LOC:Page = 6                                   !Hotkey to Page 7
  944.   PRESS(AltN)                                    !Press Next_Page Key
  945. #ENDIF
  946. #IF(%Page8Proc)
  947. OF Alt8
  948.   LOC:Page = 7                                   !Hotkey to Page 8
  949.   PRESS(AltN)                                    !Press Next_Page Key
  950. #ENDIF
  951. #IF(%Page9Proc)
  952. OF Alt9
  953.   LOC:Page = 8                                   !Hotkey to Page 9
  954.   PRESS(AltN)                                    !Press Next_Page Key
  955. #ENDIF
  956. #!***************************************************************************
  957. #GROUP(%ProcCounter)
  958.       #IF(%Page2Proc)
  959.         #SET(%ProcCount,'2')
  960.         #IF(%Page3Proc)
  961.             #SET(%ProcCount,(%ProcCount + 1))
  962.          #ENDIF
  963.          #IF(%Page4Proc)
  964.             #SET(%ProcCount,(%ProcCount + 1))
  965.          #ENDIF
  966.          #IF(%Page5Proc)
  967.             #SET(%ProcCount,(%ProcCount + 1))
  968.          #ENDIF
  969.          #IF(%Page6Proc)
  970.             #SET(%ProcCount,(%ProcCount + 1))
  971.          #ENDIF
  972.          #IF(%Page7Proc)
  973.             #SET(%ProcCount,(%ProcCount + 1))
  974.          #ENDIF
  975.          #IF(%Page8Proc)
  976.             #SET(%ProcCount,(%ProcCount + 1))
  977.          #ENDIF
  978.          #IF(%Page9Proc)
  979.             #SET(%ProcCount,(%ProcCount + 1))
  980.          #ENDIF
  981.       #ENDIF
  982. #!***************************************************************************
  983. #GROUP(%SavePrimedFields)
  984. #FOR(%Key)
  985.  #IF(%KeyAuto)
  986.   #FOR(%KeyField)
  987.    #IF(%KeyField <> %KeyAuto)
  988. Prime::%KeyField  LIKE(%KeyField)
  989.    #ENDIF
  990.   #ENDFOR
  991.  #ENDIF
  992. #ENDFOR
  993. #!***************************************************************************
  994. #GROUP(%DeclareAutoInc)
  995. #!
  996. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  997. #!│                             DeclareAutoInc             │Version: 3007.105│
  998. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  999. #!│Purpose:      Generate AutoIncrement Declarations                         │
  1000. #!│Called From:  Form, MultiPage, Form21, Child Templates                    │
  1001. #!│Assumptions:  None                                                        │
  1002. #!│Inserts:      None                                                        │
  1003. #!│Symbols Set:  None                                                        │
  1004. #!│Notes:        None                                                        │
  1005. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  1006. #!│Version   Comments                                                        │
  1007. #!│────────  ────────────────────────────────────────────────────────────────│
  1008. #!│3007.105  Added to 3007.105 templates                                     │
  1009. #!└──────────────────────────────────────────────────────────────────────────┘
  1010. #!
  1011. #SET(%GenAutoInc,%Null)
  1012. #SET(%AutoIncDups,%Null)
  1013. #FOR(%Key)
  1014.   #IF(NOT %KeyAuto)
  1015.     #IF(%KeyDuplicate)
  1016.       #SET(%AutoIncDups,'TRUE')
  1017.     #ENDIF
  1018.   #ENDIF
  1019. #ENDFOR
  1020. #SET(%KeyFieldList,%Null)
  1021. #FOR(%Key)
  1022.   #IF(%KeyAuto)
  1023.     #SET(%GenAutoInc,'TRUE')
  1024.     #FOR(%KeyField)
  1025.       #IF(%KeyField=%KeyAuto)
  1026.         #BREAK
  1027.       #ENDIF
  1028.       #SET(%KeyFieldEntry,('['&CLIP(%KeyField)&']'))
  1029.       #IF((INSTRING(%KeyFieldEntry,%KeyFieldList,1,1)))
  1030.       #ELSE
  1031.         #FIX(%Field,%KeyField)
  1032.         #IF(%FieldType='GROUP')
  1033. Auto:%KeyField     STRING(SIZE(%KeyField))      #<! Pre-AutoInc Save Value
  1034.         #ELSE
  1035. Auto:%KeyField     LIKE(%KeyField)               #<! Pre-AutoInc Save Value
  1036.         #ENDIF
  1037.         #SET(%KeyFieldList,(CLIP(%KeyFieldList)&%KeyFieldEntry))
  1038.       #ENDIF
  1039.       #ENDFOR
  1040. Auto:%KeyAuto      LIKE(%KeyAuto)                #<! AutoInc Save Value
  1041.     #IF(%AutoIncDups)
  1042. Auto:Hold:%KeyAuto LIKE(%KeyAuto)                #<! AutoInc Save Value
  1043.     #ENDIF
  1044.   #ENDIF
  1045. #ENDFOR
  1046. #IF(%GenAutoInc)
  1047. AutoIncAdd    BYTE(0)
  1048. #ENDIF
  1049. #IF(%PrimaryDriver = 'Paradox3')
  1050.   #FIX(%File,%Primary)
  1051. SavePointer   STRING(SIZE(%FilePre:Record))      !Position of current record
  1052.   #IF(%GenAutoInc)
  1053. AutoAddPtr    STRING(SIZE(%FilePre:Record))      !Position of Autoinc record
  1054.   #ENDIF
  1055. #ELSE
  1056. SavePointer   STRING(10)                         !Position of current record
  1057.   #IF(%GenAutoInc)
  1058. AutoAddPtr    STRING(10)                         !Position of Autoinc record
  1059.   #ENDIF
  1060. #ENDIF
  1061. #CHAIN('MiscGrps.TPX')
  1062.